home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 1.iso / HENSA / MATHS / PLPLOT / PLPLOT.ZIP / examples / f77 / x12f.f < prev    next >
Encoding:
Text File  |  1994-05-27  |  2.0 KB  |  94 lines
  1. ! $Id: x12f.f,v 1.2 1994/05/26 19:34:26 mjl Exp $
  2. ! $Log: x12f.f,v $
  3. ! Revision 1.2  1994/05/26  19:34:26  mjl
  4. ! Inserted missing CVS Id and Log fields for all Fortran demos.  Comment
  5. ! character changed to "!" everywhere, to work well with font-lock in Lucid
  6. ! emacs (requires a small change to fortran-mode.el).
  7. !
  8. !
  9. !     Demonstration program for PLPLOT: Bar chart example. 
  10.  
  11.       character*20 string
  12.       real y0(10)
  13.  
  14.       call plinit()
  15.  
  16.       call pladv(0)
  17.       call plvsta
  18.       call plwind(1980.,1990.,0.,35.)
  19.       call plbox("bc",1.,0,"bcnv",10.,0)
  20.       call plcol(2)
  21.       call pllab("Year","Widget Sales (millions)",
  22.      & "#frPLPLOT Example 12")
  23.  
  24.       y0(1) = 5
  25.       y0(2) = 15
  26.       y0(3) = 12
  27.       y0(4) = 24
  28.       y0(5) = 28
  29.       y0(6) = 30
  30.       y0(7) = 20
  31.       y0(8) = 8
  32.       y0(9) = 12
  33.       y0(10) = 3
  34.  
  35.       do 1 i=0,9
  36.          call plcol(mod(i,4)+1)
  37.          call plpsty(mod(i+3,8)+1)
  38.          call pllsty(mod(i,8)+1)
  39.          call plfbox(1980.+i,y0(i+1))
  40.          write(string,"(i8)")int(y0(i+1))
  41.          call lalign(string)
  42.          call plptex(1980.+i+.5,y0(i+1)+1.,1.,0.,.5,string)
  43.          write(string,"(i8)")1980+i
  44.          call lalign(string)
  45.          call plmtex("b",1.,(i+1)*.1-.05,.5,string)
  46. 1     continue
  47.  
  48. !     Don't forget to call PLEND to finish off!
  49.       call plend
  50.  
  51.       end
  52.  
  53. !     Suck up leading spaces
  54.       subroutine lalign(string)
  55.       character*(*) string
  56.       
  57.       max = len(string)
  58.  
  59.       do 1 i=1,max
  60.          if(string(i:i).ne." ") then
  61.             if(i.eq.1) return
  62.             k = 1
  63.             do 2 j=i,max
  64.                string(k:k) = string(j:j)
  65.                k = k + 1
  66. 2           continue
  67.             do 3 j=k,max
  68.                string(j:j) = " "
  69. 3           continue
  70.             return
  71.          endif
  72. 1     continue
  73.  
  74.       end
  75.  
  76.       subroutine plfbox(x0,y0)
  77.  
  78.       real x(4), y(4)
  79.  
  80.       x(1) = x0
  81.       y(1) = 0.
  82.       x(2) = x0
  83.       y(2) = y0
  84.       x(3) = x0+1.
  85.       y(3) = y0
  86.       x(4) = x0+1.
  87.       y(4) = 0.
  88.       call plfill(4,x,y)
  89.       call plcol(1)
  90.       call pllsty(1)
  91.       call plline(4,x,y)
  92.  
  93.       end
  94.